home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr09 / cvec.zip / CVEC.BAS next >
BASIC Source File  |  1993-06-16  |  11KB  |  287 lines
  1.  
  2.  
  3. 'CVEC.    Uses PAF data base to build file of C-Vectors. Output
  4. 'file contains the vector elements, sex, a file identification
  5. 'character, and name of the base individual.
  6. '
  7. 'The C-Vector is an array of seven integers.  Each element is the
  8. 'birth year of an individual as follows:
  9. '               1  Individual
  10. '               2  Father
  11. '               3  Mother
  12. '               4  Paternal Grandfather
  13. '               5  Paternal Grandmother
  14. '               6  Maternal Grandfather
  15. '               7  Maternal Grandmother
  16. ' Taken as an individual indentifier, the C-Vector is very nearly unique.
  17. ' It is independent of data base format and vagaries of surname spelling.
  18. ' Once a single individual is found in common between two data bases,
  19. ' ancestors from that point back are held in common.
  20. ' C-Vector comparisons are gender independent - the same for male and
  21. ' female lines.
  22. '
  23. ' For more information see article in July, 1990 issue of
  24. '   Genealogical Computing Magazine.
  25. '
  26. 'Version 1.0.    3/23/90
  27. '(c) Copyright 1990 Peter G. Cook, 435 E. Barbarita Ave., Gilbert, AZ.
  28.  
  29.  
  30. DEFINT A-Z
  31. DECLARE FUNCTION BirthYear$ (DateField$)
  32. DECLARE SUB BuildName (Gender, Titl, G1, G2, G3, BuiltName$)
  33.  
  34. DECLARE SUB Grandparents (Pointer%, VN1$, VN2$)
  35. DECLARE SUB GetName (NameNo%, NameWord$)
  36.  
  37. TYPE Place
  38.     Place1              AS INTEGER      'Placename 1
  39.     Place2              AS INTEGER      'Placename 2
  40.     Place3              AS INTEGER      'Placename 3
  41.     Place4              AS INTEGER      'Placename 4
  42. END TYPE
  43.  
  44.  
  45. TYPE Individual 'Individual file (INDIV2.DAT) format.
  46.     Sur                 AS INTEGER      'Surname
  47.     G1                  AS INTEGER      'Given name 1
  48.     G2                  AS INTEGER      'Given name 2
  49.     G3                  AS INTEGER      'Given name 3
  50.     Titl                AS INTEGER      'Title
  51.     Gender              AS STRING * 1   'M = male, F = female, D = deleted
  52.     BDate               AS STRING * 4   'Birthdate compacted
  53.     Birth               AS Place        'Birth place pointers
  54.     CDate               AS STRING * 4   'Christen date compacted
  55.     Christen            AS Place        'Christen place pointers
  56.     DDate               AS STRING * 4   'Death date compacted
  57.     Death               AS Place        'Death place pointers
  58.     BurDate             AS STRING * 4   'Burial death date compacted
  59.     Burial              AS Place        'Burial place pointers
  60.     Baptdate            AS STRING * 3   'Baptism date compacted
  61.     BaptTmple           AS INTEGER      'Baptism temple
  62.     EDate               AS STRING * 3   'Endowment date
  63.     ETempl              AS INTEGER      'Endowment temple
  64.     CPSealDate          AS STRING * 3   'Child to Parent sealing date
  65.     CPSealTmpl          AS INTEGER      'Child to Parent sealing temple                    
  66.     SibPtr              AS INTEGER      'Sibling pointer (RIN)
  67.     OwnMarriage         AS INTEGER      'Own marriage MRIN
  68.     PMarriage           AS INTEGER      'Parent Marriage MRIN
  69.     ID                  AS STRING * 10  'ID Field
  70.     NPointer            AS INTEGER      'Note Pointer
  71. END TYPE
  72.  
  73.  
  74. TYPE Marriage  'Marriage file (MARR2.DAT) format.
  75.     Husband             AS INTEGER      'Husband RIN
  76.     Wife                AS INTEGER      'Wife RIN
  77.     Child               AS INTEGER      'First child RIN
  78.     MDate               AS STRING * 4   'Marriage date compacted
  79.     LocMarriage         AS Place        'Location of marriage
  80.     WHSealDate          AS STRING * 3   'Wife to Husband seal date
  81.     WHSealTempl         AS INTEGER      'Wife to husband seal temple
  82.     HOtherMarriage      AS INTEGER      'Husband other marriage MRIN
  83.     WOtherMarriage      AS INTEGER      'Wife other marriage MRIN
  84.     Divorce             AS STRING * 1   'Y = yes, D = deleted
  85. END TYPE
  86.  
  87. TYPE NameWord  'Name file (NAME2.DAT) format.
  88.     LeftLink            AS INTEGER
  89.     NameField          AS STRING * 17   'Word pointed to by place & name ptrs
  90.     RightLink           AS INTEGER
  91. END TYPE
  92.  
  93.  
  94.  
  95.  
  96. TYPE CVector  'Output C-Vector file format.
  97.     CV1                 AS STRING * 5    'Individual birth year
  98.     CV2                 AS STRING * 5    'Father's birth year
  99.     CV3                 AS STRING * 5    'Mother's birth year
  100.     CV4                 AS STRING * 5    'Paternal Grandfather's birth year
  101.     CV5                 AS STRING * 5    'Paternal Grandmother's birth year
  102.     CV6                 AS STRING * 5    'Maternal Grandfather's birth year
  103.     CV7                 AS STRING * 5    'Maternal Grandmother's birthyear
  104.     Gender              AS STRING * 1    'Gender
  105.     RIN                 AS STRING * 6    'Individual ident number
  106.     AName               AS STRING * 20   'Ancestor's name
  107. END TYPE
  108.  
  109.  
  110. 'Define specific record variable names, and open the files.
  111. 'User can specify another directory for the PAF files, or stick with
  112. '   the current one.
  113.  
  114. DIM SHARED NRec         AS NameWord     'Name Record
  115. DIM SHARED CVREC        AS CVector      'C-Vector Record
  116. DIM SHARED IRec         AS Individual   'Individual Record
  117. DIM SHARED FREC         AS Individual   'Father Record
  118. DIM SHARED MRec         AS Individual   'Mother Record
  119. DIM SHARED GFRec        AS Individual   'Grandfather Record
  120. DIM SHARED GMRec        AS Individual   'Grandmother record
  121. DIM SHARED PMRec        AS Marriage     'Parents Marriage Record
  122. DIM SHARED GPMRec       AS Marriage     'Grandparents marriage record
  123. DIM SHARED ElementCount
  124.  
  125.  
  126. INPUT "Enter directory containing PAF Files, ENTER alone for current dir: ", DIR$
  127. OPEN DIR$ + "\INDIV2.DAT" FOR RANDOM AS #2 LEN = 92 'Open Individual file
  128. OPEN DIR$ + "\MARR2.DAT" FOR RANDOM AS #1 LEN = 28   'Open Marriage file
  129. OPEN DIR$ + "\NAME2.DAT" FOR RANDOM AS #4 LEN = 21'Open Name file
  130.  
  131. 'Get the filename of the output file desired.  Full pathname is OK,
  132. 'or just file name for current directory.
  133.  
  134. INPUT "Enter name of output file to receive C-Vectors: ", CVecFName$
  135. OPEN CVecFName$ FOR OUTPUT AS #3
  136.  
  137. 'Get file identification letter to appear with each C-Vector
  138. INPUT "Enter a single letter to identify this file's C_Vectors: ", Ltr$
  139. Ltr$ = " " + LEFT$(Ltr$, 1) 'make sure it's just one letter, add space
  140.  
  141. VectorCount = 0 'Initialize count of vectors written
  142.  
  143. LastRecord = LOF(2) \ LEN(IRec)  'Find number of last record
  144.  
  145. FOR I = 2 TO LastRecord    'Skip the header record, step through individuals
  146.  
  147.     CVREC.CV1 = " 0000"  'Set all of the C-Vector elements to " 0000"
  148.     CVREC.CV2 = " 0000"  'to indicates missing date.
  149.     CVREC.CV3 = " 0000"
  150.     CVREC.CV4 = " 0000"
  151.     CVREC.CV5 = " 0000"
  152.     CVREC.CV6 = " 0000"
  153.     CVREC.CV7 = " 0000"
  154.  
  155.     ElementCount = 0    'Counter to keep track of valid element count
  156.  
  157.     GET #2, I, IRec   'Read individual's record
  158.    
  159.     'Don't process this record if it has been deleted.
  160.     IF IRec.Gender = "D" THEN GOTO BailOut
  161.  
  162.    
  163.     'Don't process this person if no birthyear available.
  164.     CVREC.CV1 = BirthYear$(IRec.BDate)
  165.     IF CVREC.CV1 = " 0000" THEN GOTO BailOut
  166.     
  167.     CVREC.RIN = STR$(I - 1)
  168.     CVREC.Gender = IRec.Gender  'Move gender
  169.     IF IRec.Gender = "" THEN CVREC.Gender = "U"
  170.     'Generate ancestor name
  171.     CALL BuildName(IRec.Sur, IRec.Titl, IRec.G1, IRec.G2, IRec.G3, BuiltName$)
  172.     CVREC.AName = BuiltName$
  173.     ElementCount = ElementCount + 1  'Bump good element count
  174.        
  175.     'Get Parent Marriage record if available, find parents or bail out.
  176.     '(Note that header record makes all random access record numbers
  177.     '   = RIN or MRIN +1)
  178.     IF IRec.PMarriage = 0 THEN GOTO BailOut
  179.  
  180.  
  181.     GET #1, IRec.PMarriage + 1, PMRec 'Get parent's marriage
  182.  
  183.     IF PMRec.Husband = 0 THEN GOTO BailOut 'Bail out if no Father
  184.    
  185.     'Process Father
  186.     GET #2, PMRec.Husband + 1, FREC  'Get his record
  187.     
  188.     CVREC.CV2 = BirthYear$(FREC.BDate) 'Move birthdate
  189.     IF CVREC.CV2 = " 0000" THEN GOTO BailOut  'Bail out if no birthdate
  190.  
  191.     'Process paternal grandparents if available
  192.     IF FREC.PMarriage <> 0 THEN
  193.         CALL Grandparents(FREC.PMarriage + 1, CVREC.CV4, CVREC.CV5)
  194.     END IF  'Done looking for paternal line
  195.  
  196.     'Process Mother and Maternal Grandparents
  197.     IF PMRec.Wife <> 0 THEN
  198.         GET #2, PMRec.Wife + 1, MRec  'Get her record
  199.         CVREC.CV3 = BirthYear$(MRec.BDate)
  200.         IF CVREC.CV3 <> " 0000" THEN ElementCount = ElementCount + 1
  201.  
  202.  
  203.         'Process maternal grandparents if available
  204.         IF MRec.PMarriage <> 0 THEN
  205.             CALL Grandparents(MRec.PMarriage + 1, CVREC.CV6, CVREC.CV7)
  206.         END IF
  207.     END IF 'Done looking for maternal line
  208.  
  209. 'Now we will write out the C-Vector if we have found 3 or more years
  210. IF ElementCount < 3 THEN GOTO BailOut
  211. VectorCount = VectorCount + 1
  212. PRINT #3, CVREC.CV1; CVREC.CV2; CVREC.CV3; CVREC.CV4; CVREC.CV5; CVREC.CV6; CVREC.CV7; " "; CVREC.Gender; Ltr$; CVREC.RIN; CVREC.AName
  213.  
  214.  
  215. BailOut: NEXT I
  216.  
  217. PRINT VectorCount; " Records written to file "; CVecFName$
  218. CLOSE 'Close all files
  219.  
  220. END 'Done
  221.  
  222. 'Function to extract BirthYear from the PAF compact date format
  223. FUNCTION BirthYear$ (DateField$)
  224. D1$ = MID$(DateField$, 1, 1)
  225. D2$ = MID$(DateField$, 2, 1)
  226. BYr = ASC(D1$) * 16 + ASC(D2$) \ 16
  227.  
  228. IF BYr = 0 THEN
  229.     BirthYear$ = " 0000" 'Set to no year if none in record
  230.     ELSE BirthYear$ = STR$(BYr)
  231. END IF
  232. END FUNCTION
  233.  
  234. 'Function to find 17 character name fields and pack into a single string
  235. SUB BuildName (surname, Title, G1, G2, G3, BuiltName$) STATIC
  236.  
  237.  
  238. CALL GetName(surname, SSurname$)'Get parts of name
  239. CALL GetName(Title, STtitle$)
  240. CALL GetName(G1, SG1$): SG1$ = " " + SG1$ ')get names,
  241. CALL GetName(G2, SG2$): SG2$ = " " + SG2$ ')set spacing
  242. CALL GetName(G3, SG3$): SG3$ = " " + SG3$ ')
  243.  
  244. BuiltName$ = " " + UCASE$(RTRIM$(SSurname$)) + "," + RTRIM$(STitle$) + RTRIM$(SG1$) + RTRIM$(SG2$) + RTRIM$(SG3$)
  245. END SUB
  246.  
  247. 'Subprogram to locate alphabetics with name file record pointers
  248. SUB GetName (NameNo, NameW$) STATIC
  249. SHARED NRec AS NameWord
  250. IF NameNo = 0 THEN
  251.     NameW$ = ""  'Null string if no pointer
  252. ELSE
  253.     RecNo = NameNo + 1
  254.     GET #4, RecNo, NRec    'Get the Name Word
  255.     NameW$ = NRec.NameField
  256.  
  257.         FOR C = 1 TO 17 'make sure trailing characters are all spaces
  258.                 T$ = MID$(NameW$, C, 1)
  259.                 IF T$ < " " THEN MID$(NameW$, C, 1) = " "
  260.         NEXT C
  261. END IF
  262. END SUB
  263.  
  264. 'Subprogram to process grandparents birth years
  265. SUB Grandparents (Pointer, VN1$, VN2$)
  266.        
  267.         GET #1, Pointer, GPMRec 'get their marriage
  268.         IF GPMRec.Husband <> 0 THEN  'Does he have a record?
  269.             GET #2, GPMRec.Husband + 1, GFRec  'Get it
  270.             VN1$ = BirthYear$(GFRec.BDate)  'Extract date
  271.             IF VN1$ <> " 0000" THEN
  272.                 ElementCount = ElementCount + 1
  273.             END IF
  274.         END IF 'Grandfather processed
  275.  
  276.         IF GPMRec.Wife <> 0 THEN 'Does she have a record?
  277.             GET #2, GPMRec.Wife + 1, GMRec 'Get it
  278.             VN2$ = BirthYear$(GMRec.BDate) 'Extract date
  279.             IF VN2$ <> " 0000" THEN
  280.                 ElementCount = ElementCount + 1
  281.             END IF
  282.         END IF 'Grandmother processed
  283.  
  284.  
  285. END SUB
  286.